library(readr)
epl <- read_csv("~/Google Drive/KHU SNS/2nd Semester/SNS Analysis/Final/Total.csv")## Parsed with column specification:
## cols(
## Name = col_character(),
## Age = col_integer(),
## Position = col_character(),
## MarketValue = col_character(),
## From = col_character(),
## To = col_character(),
## TransferFee = col_character()
## )
head(epl)## # A tibble: 6 × 7
## Name Age Position MarketValue From
## <chr> <int> <chr> <chr> <chr>
## 1 Islam Slimani 28 Centre-Forward £18.70m Sporting CP
## 2 Ahmed Musa 23 Centre-Forward £15.30m CSKA Moscow
## 3 Nampalys Mendy 24 Defensive Midfield £6.38m OGC Nice
## 4 Bartosz Kapustka 19 Attacking Midfield £4.25m Cracovia Kraków
## 5 Ron-Robert Zieler 27 Keeper £6.80m Hannover 96
## 6 Luis Hernández 26 Centre-Back £2.13m Sporting Gijón
## # ... with 2 more variables: To <chr>, TransferFee <chr>
library(dplyr)##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
epl <- epl %>%
filter(To != "Unattached") %>%
filter(To != "End of career") %>%
filter(From != "Unattached")
epl$MarketValue <- gsub(x = epl$MarketValue, pattern = "£", replacement = "")
epl$TransferFee <- gsub(x = epl$TransferFee, pattern = "£", replacement = "")
epl$TransferFee[which(epl$From == "Unattached")] <- epl$MarketValue[which(epl$From == "Unattached")]
epl$TransferFee[which(epl$TransferFee == "Free transfer")] <- epl$MarketValue[which(epl$TransferFee == "Free transfer")]
epl$TransferFee[which(epl$TransferFee == "?")] <- epl$MarketValue[which(epl$TransferFee == "?")]
epl$TransferFee[which(epl$TransferFee == "-0")] <- epl$MarketValue[which(epl$TransferFee == "-0")]
epl <- epl %>%
filter(substring(TransferFee, 1, 1) %in% 1:9)
head(epl)## # A tibble: 6 × 7
## Name Age Position MarketValue From
## <chr> <int> <chr> <chr> <chr>
## 1 Islam Slimani 28 Centre-Forward 18.70m Sporting CP
## 2 Ahmed Musa 23 Centre-Forward 15.30m CSKA Moscow
## 3 Nampalys Mendy 24 Defensive Midfield 6.38m OGC Nice
## 4 Bartosz Kapustka 19 Attacking Midfield 4.25m Cracovia Kraków
## 5 Ron-Robert Zieler 27 Keeper 6.80m Hannover 96
## 6 Luis Hernández 26 Centre-Back 2.13m Sporting Gijón
## # ... with 2 more variables: To <chr>, TransferFee <chr>
cleanEPL <- epl[-which(duplicated(epl$Name)), ]
head(cleanEPL)## # A tibble: 6 × 7
## Name Age Position MarketValue From
## <chr> <int> <chr> <chr> <chr>
## 1 Islam Slimani 28 Centre-Forward 18.70m Sporting CP
## 2 Ahmed Musa 23 Centre-Forward 15.30m CSKA Moscow
## 3 Nampalys Mendy 24 Defensive Midfield 6.38m OGC Nice
## 4 Bartosz Kapustka 19 Attacking Midfield 4.25m Cracovia Kraków
## 5 Ron-Robert Zieler 27 Keeper 6.80m Hannover 96
## 6 Luis Hernández 26 Centre-Back 2.13m Sporting Gijón
## # ... with 2 more variables: To <chr>, TransferFee <chr>
cleanEPL <- cleanEPL[-which(cleanEPL$To == "Unknown"), ]vector <- cleanEPL$TransferFee
makeWeight <- function(vector){
weight <- ifelse(grepl(x = vector, pattern = "m"),
as.numeric(gsub(x = vector, pattern = "m", replacement = "")),
as.numeric(gsub(x = vector, pattern = "k", replacement = "")) / 1000)
return(weight)
}
cleanEPL$TransferFee <- makeWeight(cleanEPL$TransferFee)## Warning in ifelse(grepl(x = vector, pattern = "m"), as.numeric(gsub(x =
## vector, : NAs introduced by coercion
## Warning in ifelse(grepl(x = vector, pattern = "m"), as.numeric(gsub(x =
## vector, : NAs introduced by coercion
cleanEPL$MarketValue <- makeWeight(cleanEPL$MarketValue)## Warning in ifelse(grepl(x = vector, pattern = "m"), as.numeric(gsub(x =
## vector, : NAs introduced by coercion
## Warning in ifelse(grepl(x = vector, pattern = "m"), as.numeric(gsub(x =
## vector, : NAs introduced by coercion
head(cleanEPL)## # A tibble: 6 × 7
## Name Age Position MarketValue From
## <chr> <int> <chr> <dbl> <chr>
## 1 Islam Slimani 28 Centre-Forward 18.70 Sporting CP
## 2 Ahmed Musa 23 Centre-Forward 15.30 CSKA Moscow
## 3 Nampalys Mendy 24 Defensive Midfield 6.38 OGC Nice
## 4 Bartosz Kapustka 19 Attacking Midfield 4.25 Cracovia Kraków
## 5 Ron-Robert Zieler 27 Keeper 6.80 Hannover 96
## 6 Luis Hernández 26 Centre-Back 2.13 Sporting Gijón
## # ... with 2 more variables: To <chr>, TransferFee <dbl>
epl <- select(cleanEPL, From:TransferFee) %>%
arrange(From)
head(epl)## # A tibble: 6 × 3
## From To TransferFee
## <chr> <chr> <dbl>
## 1 1. FC Köln VFL Wolfsburg 11.050
## 2 1. FC Köln TSG Hoffenheim 2.550
## 3 1. FC Köln Slavia Prag 0.638
## 4 1. FC Köln Omonia Nikosia 0.595
## 5 1. FC Köln Union Berlin 0.128
## 6 1.FC Heidenheim FC Schalke 04 0.255
financeSize <- data.frame(Team = c(epl$From, epl$To), TransferFee = rep(epl$TransferFee, 2)) %>%
group_by(Team) %>%
summarise(Size = sum(TransferFee))teamlist <- unique(c(epl$From, epl$To))
teamlist <- data.frame(Team = teamlist)
teamlist <- arrange(teamlist, Team)
team <- read_csv("Team.csv")## Parsed with column specification:
## cols(
## Team = col_character(),
## League = col_character()
## )
teamlist <- left_join(teamlist, team)## Joining, by = "Team"
## Warning in left_join_impl(x, y, by$x, by$y, suffix$x, suffix$y): joining
## character vector and factor, coercing into character vector
teamlist$League[is.na(teamlist$League)] <- "Miscellaneous"
teamlist$League <- as.factor(teamlist$League)
teamlist$Size <- financeSize$Size
leagues <- levels(teamlist$League)team_nodes <- data.frame(id = paste0("team", sprintf("%03d", 1:nrow(teamlist))),
label = teamlist$Team,
group.label = teamlist$League,
value = teamlist$Size) %>%
mutate(group = as.factor(group.label))
from <- left_join(epl[, 1], select(team_nodes, label, id), by = c("From" = "label"))## Warning in left_join_impl(x, y, by$x, by$y, suffix$x, suffix$y): joining
## factor and character vector, coercing into character vector
to <- left_join(epl[, 2], select(team_nodes, label, id), by = c("To" = "label"))## Warning in left_join_impl(x, y, by$x, by$y, suffix$x, suffix$y): joining
## factor and character vector, coercing into character vector
team_links <- data.frame(from, to, weight = epl$TransferFee) %>%
select(id, id.1, weight)
names(team_links) <- c("from", "to", "weight")label <- levels(team_nodes$group.label)
team_nodes$group.label <- as.numeric(team_nodes$group.label)head(team_nodes)## id label group.label value group
## 1 team001 1. FC Köln 4 21.431 Germany
## 2 team002 1.FC Heidenheim 7 0.255 Miscellaneous
## 3 team003 1.FC K'lautern 7 2.620 Miscellaneous
## 4 team004 1.FC Nuremberg 7 2.210 Miscellaneous
## 5 team005 1.FSV Mainz 05 4 31.666 Germany
## 6 team006 1860 Munich 7 3.103 Miscellaneous
head(team_links)## from to weight
## 1 team001 team480 11.050
## 2 team001 team462 2.550
## 3 team001 team422 0.638
## 4 team001 team331 0.595
## 5 team001 team471 0.128
## 6 team002 team180 0.255
library(igraph)##
## Attaching package: 'igraph'
## The following objects are masked from 'package:dplyr':
##
## %>%, as_data_frame, groups, union
## The following objects are masked from 'package:stats':
##
## decompose, spectrum
## The following object is masked from 'package:base':
##
## union
network <- graph_from_data_frame(d = team_links, vertices = team_nodes, directed = FALSE)network## IGRAPH UNW- 504 1069 --
## + attr: name (v/c), label (v/c), group.label (v/n), value (v/n),
## | group (v/c), weight (e/n)
## + edges (vertex names):
## [1] team001--team480 team001--team462 team001--team422 team001--team331
## [5] team001--team471 team002--team180 team003--team367 team004--team154
## [9] team005--team278 team005--team066 team003--team005 team005--team386
## [13] team005--team332 team010--team431 team012--team206 team012--team346
## [17] team012--team404 team013--team083 team014--team056 team014--team467
## [21] team014--team079 team014--team047 team014--team404 team014--team128
## [25] team014--team200 team014--team102 team012--team014 team017--team095
## + ... omitted several edges
E(network)## + 1069/1069 edges (vertex names):
## [1] team001--team480 team001--team462 team001--team422 team001--team331
## [5] team001--team471 team002--team180 team003--team367 team004--team154
## [9] team005--team278 team005--team066 team003--team005 team005--team386
## [13] team005--team332 team010--team431 team012--team206 team012--team346
## [17] team012--team404 team013--team083 team014--team056 team014--team467
## [21] team014--team079 team014--team047 team014--team404 team014--team128
## [25] team014--team200 team014--team102 team012--team014 team017--team095
## [29] team018--team173 team020--team374 team021--team329 team023--team446
## [33] team023--team296 team023--team167 team023--team435 team023--team124
## [37] team018--team023 team023--team423 team023--team171 team023--team423
## + ... omitted several edges
V(network)## + 504/504 vertices, named:
## [1] team001 team002 team003 team004 team005 team006 team007 team008
## [9] team009 team010 team011 team012 team013 team014 team015 team016
## [17] team017 team018 team019 team020 team021 team022 team023 team024
## [25] team025 team026 team027 team028 team029 team030 team031 team032
## [33] team033 team034 team035 team036 team037 team038 team039 team040
## [41] team041 team042 team043 team044 team045 team046 team047 team048
## [49] team049 team050 team051 team052 team053 team054 team055 team056
## [57] team057 team058 team059 team060 team061 team062 team063 team064
## [65] team065 team066 team067 team068 team069 team070 team071 team072
## [73] team073 team074 team075 team076 team077 team078 team079 team080
## + ... omitted several vertices
V(network)$size <- log(V(network)$value + 1) * 1.5
plot(network, edge.arrow.size = .05, edge.curved = .1,
vertex.color="orange", vertex.frame.color="#555555",
vertex.label=V(network)$label, vertex.label.color="black",
vertex.label.cex=.2, rescale = T) colors <- c("sienna2", "gray80", "dodgerblue", "lightsalmon4", "paleturquoise", "darkolivegreen3", "gray20", "tan1", "springgreen4", "lightseagreen", "goldenrod1", "firebrick1", "lightpink2")
V(network)$color <- colors[V(network)$group.label]
V(network)$size <- log(V(network)$value + 1) * 1.2
plot(network, edge.arrow.size = .01, edge.curved = .1,
vertex.frame.color="#555555", edge.width = .5,
vertex.label=V(network)$label, vertex.label.color="black",
vertex.label.cex=.4, rescale = T)
legend(x = -.8, y = -1, label, pch = 21, cex = 0.5,
text.width = 0.2, col="#777777", pt.bg = colors, pt.cex = 1, bty = "n", ncol = 5)edge.color <- 1:length(E(network))
for(i in 1:nrow(team_nodes)){
index <- incident(network, V(network)[i])
group_index <- team_nodes[i, "group.label"]
edge.color[index] <- colors[group_index]
}
E(network)$edge.color <- edge.colorvertex.color <- colors[V(network)$group.label]
plot(network, edge.arrow.size = .02,
vertex.frame.color = adjustcolor("#555555", alpha = .3),
edge.width = .5,
edge.color = adjustcolor(edge.color, alpha.f = .7),
vertex.color = adjustcolor(vertex.color, alpha = .6),
vertex.label = V(network)$label,
vertex.label.color = "black",
vertex.label.cex = .35,
vertex.label.family = "Helvetica",
layout=layout_nicely(network)
)
legend(x = -.9, y = -1, label, pch = 21, cex = 0.5,
text.width = 0.2, col= adjustcolor(vertex.color, alpha.f = .4),
pt.bg = adjustcolor(colors, alpha = .6), pt.cex = 1, bty = "n", ncol = 5)V(network)$degree <- degree(network)
V(network)$closeness <- centralization.closeness(network)$res
V(network)$betweenness <- centralization.betweenness(network)$res
V(network)$eigen <- centralization.evcent(network)$vector# This function implements the community detection method described in: Raghavan, U.N. and Albert, R. and Kumara, S.: Near linear time algorithm to detect community structures in large-scale networks. Phys Rev E 76, 036106. (2007). This version extends the original method by the ability to take edge weights into consideration and also by allowing some labels to be fixed.
# From the abstract of the paper: “In our algorithm every node is initialized with a unique label and at every step each node adopts the label that most of its neighbors currently have. In this iterative process densely connected groups of nodes form a consensus on a unique label to form communities.”
clp <- cluster_label_prop(network)
clp## IGRAPH clustering label propagation, groups: 31, mod: 0.55
## + groups:
## $`1`
## [1] "team001" "team120" "team140" "team185" "team331" "team357" "team408"
## [8] "team422" "team480"
##
## $`2`
## [1] "team002" "team027" "team054" "team114" "team126" "team161"
## [7] "team162" "team168" "team178" "team180" "team188" "team209"
## [13] "team243" "team261" "team289" "team292" "team295" "team299"
## [19] "team328" "team419" "team470" "team501"
##
## + ... omitted several groups/vertices
football_adjacency <- as.matrix(get.adjacency(network))
colnames(football_adjacency) <- 1:nrow(football_adjacency)
row.names(football_adjacency) <- 1:nrow(football_adjacency)
write.csv(football_adjacency, "adjacency.csv")# Re-generate dataframes for both nodes and edges, now containing
# calculated network attributes
node_list <- get.data.frame(network, what = "vertices")
# Determine a community for each edge. If two nodes belong to the
# same community, label the edge with that community. If not,
# the edge community value is 'NA'
edge_list <- get.data.frame(network, what = "edges") %>%
inner_join(node_list %>% select(name, group.label), by = c("from" = "name")) %>%
inner_join(node_list %>% select(name, group.label), by = c("to" = "name")) %>%
mutate(group = as.factor(group.label.x))
edge_list <- data.frame(from = c(edge_list$from, edge_list$to),
to = c(edge_list$to, edge_list$from),
edge.color = rep(edge_list$edge.color, 2),
group.label.x = rep(edge_list$group.label.x, 2),
group.label.y = rep(edge_list$group.label.y, 2),
group = rep(edge_list$group, 2)
)
# Create a character vector containing every node name
all_nodes <- sort(node_list$name)
# Adjust the 'to' and 'from' factor levels so they are equal
# to this complete list of node names
plot_data <- edge_list %>% mutate(
to = factor(to, levels = all_nodes),
from = factor(from, levels = all_nodes))
name_order <- (node_list %>% arrange(group.label))$name
# Reorder edge_list "from" and "to" factor levels based on
# this new name_order
plot_data <- edge_list %>% mutate(
to = factor(to, levels = name_order),
from = factor(from, levels = name_order))adjacency <- ggplot(plot_data, aes(x = from, y = to, fill = group)) +
geom_raster() +
# Because we need the x and y axis to display every node,
# not just the nodes that have connections to each other,
# make sure that ggplot does not drop unused factor levels
scale_x_discrete(drop = FALSE) +
scale_y_discrete(drop = FALSE) +
xlab(NULL) + ylab(NULL) +
scale_fill_manual(values = colors,
labels = leagues,
name = "Leagues") +
theme(
# Rotate the x-axis lables so they are legible
axis.text.x = element_blank(),
axis.text.y = element_blank(),
# Force the plot into a square aspect ratio
aspect.ratio = 1
# Hide the legend (optional)
)
adjacency# EPL, La Liga, Bundesliga, Serie A
epl.list <- node_list %>%
filter(group == "England") %>%
.$name
laliga.list <- node_list %>%
filter(group == "Spain") %>%
.$name
bundes.list <- node_list %>%
filter(group == "Germany") %>%
.$name
seriea.list <- node_list %>%
filter(group == "Italy") %>%
.$nameepl.links <- team_links %>%
filter(from %in% epl.list | to %in% epl.list)
epl.nodes <- team_nodes %>%
filter(id %in% unique(c(as.character(epl.links$from), as.character(epl.links$to))))epl.network <- graph_from_data_frame(d = epl.links, vertices = epl.nodes, directed = FALSE)V(epl.network)$degree <- degree(epl.network)
V(epl.network)$closeness <- centralization.closeness(epl.network)$res
V(epl.network)$betweenness <- centralization.betweenness(epl.network)$res
V(epl.network)$eigen <- centralization.evcent(epl.network)$vectorV(epl.network)$size <- log(V(epl.network)$value + 1) * 1.5
edge.color <- 1:length(E(epl.network))
for(i in 1:nrow(epl.nodes)){
index <- incident(epl.network, V(epl.network)[i], mode = 'out')
group_index <- epl.nodes[i, "group.label"]
edge.color[index] <- colors[group_index]
}
vertex.color <- colors[V(epl.network)$group.label]
plot(epl.network, edge.arrow.size = .02,
vertex.frame.color = adjustcolor("#555555", alpha = .3),
edge.width = .5,
edge.color = adjustcolor(edge.color, alpha.f = .7),
vertex.color = adjustcolor(vertex.color, alpha = .6),
vertex.label = V(epl.network)$label,
vertex.label.color = "black",
vertex.label.cex = .35,
vertex.label.family = "Helvetica",
layout=layout_nicely(epl.network)
)
legend(x = -.9, y = -1, label, pch = 21, cex = 0.5,
text.width = 0.2, col= adjustcolor(vertex.color, alpha.f = .4),
pt.bg = adjustcolor(colors, alpha = .6), pt.cex = 1, bty = "n", ncol = 5)# Re-generate dataframes for both nodes and edges, now containing
# calculated network attributes
node_list <- get.data.frame(epl.network, what = "vertices")
# Determine a community for each edge. If two nodes belong to the
# same community, label the edge with that community. If not,
# the edge community value is 'NA'
edge_list <- get.data.frame(epl.network, what = "edges") %>%
inner_join(node_list %>% select(name, group.label), by = c("from" = "name")) %>%
inner_join(node_list %>% select(name, group.label), by = c("to" = "name")) %>%
mutate(group = as.factor(group.label.x))
edge_list <- data.frame(from = c(edge_list$from, edge_list$to),
to = c(edge_list$to, edge_list$from),
group.label.x = rep(edge_list$group.label.x, 2),
group.label.y = rep(edge_list$group.label.y, 2),
group = rep(edge_list$group, 2)
)
# Create a character vector containing every node name
all_nodes <- sort(node_list$name)
# Adjust the 'to' and 'from' factor levels so they are equal
# to this complete list of node names
plot_data <- edge_list %>% mutate(
to = factor(to, levels = all_nodes),
from = factor(from, levels = all_nodes))
name_order <- (node_list %>% arrange(group.label))$name
# Reorder edge_list "from" and "to" factor levels based on
# this new name_order
plot_data <- edge_list %>% mutate(
to = factor(to, levels = name_order),
from = factor(from, levels = name_order))
epl.adjacency <- ggplot(plot_data, aes(x = from, y = to, fill = group)) +
geom_raster() +
# Because we need the x and y axis to display every node,
# not just the nodes that have connections to each other,
# make sure that ggplot does not drop unused factor levels
scale_x_discrete(drop = FALSE) +
scale_y_discrete(drop = FALSE) +
xlab(NULL) + ylab(NULL) +
scale_fill_manual(values = colors[-12],
labels = leagues[-12],
name = "Leagues") +
theme(
# Rotate the x-axis lables so they are legible
axis.text.x = element_blank(),
axis.text.y = element_blank(),
# Force the plot into a square aspect ratio
aspect.ratio = 1
# Hide the legend (optional)
)
epl.adjacencylaliga.links <- team_links %>%
filter(from %in% laliga.list | to %in% laliga.list)
laliga.nodes <- team_nodes %>%
filter(id %in% unique(c(as.character(laliga.links$from), as.character(laliga.links$to))))laliga.network <- graph_from_data_frame(d = laliga.links, vertices = laliga.nodes, directed = FALSE)V(laliga.network)$degree <- degree(laliga.network)
V(laliga.network)$closeness <- centralization.closeness(laliga.network)$res
V(laliga.network)$betweenness <- centralization.betweenness(laliga.network)$res
V(laliga.network)$eigen <- centralization.evcent(laliga.network)$vectorV(laliga.network)$size <- log(V(laliga.network)$value + 1) * 1.5
edge.color <- 1:length(E(laliga.network))
for(i in 1:nrow(laliga.nodes)){
index <- incident(laliga.network, V(laliga.network)[i], mode = 'out')
group_index <- laliga.nodes[i, "group.label"]
edge.color[index] <- colors[group_index]
}
vertex.color <- colors[V(laliga.network)$group.label]
plot(laliga.network, edge.arrow.size = .02,
vertex.frame.color = adjustcolor("#555555", alpha = .3),
edge.width = .5,
edge.color = adjustcolor(edge.color, alpha.f = .7),
vertex.color = adjustcolor(vertex.color, alpha = .6),
vertex.label = V(laliga.network)$label,
vertex.label.color = "black",
vertex.label.cex = .35,
vertex.label.family = "Helvetica",
layout=layout_nicely(laliga.network)
)
legend(x = -.9, y = -1, label, pch = 21, cex = 0.5,
text.width = 0.2, col= adjustcolor(vertex.color, alpha.f = .4),
pt.bg = adjustcolor(colors, alpha = .6), pt.cex = 1, bty = "n", ncol = 5)# Re-generate dataframes for both nodes and edges, now containing
# calculated network attributes
node_list <- get.data.frame(laliga.network, what = "vertices")
# Determine a community for each edge. If two nodes belong to the
# same community, label the edge with that community. If not,
# the edge community value is 'NA'
edge_list <- get.data.frame(laliga.network, what = "edges") %>%
inner_join(node_list %>% select(name, group.label), by = c("from" = "name")) %>%
inner_join(node_list %>% select(name, group.label), by = c("to" = "name")) %>%
mutate(group = as.factor(group.label.x))
edge_list <- data.frame(from = c(edge_list$from, edge_list$to),
to = c(edge_list$to, edge_list$from),
group.label.x = rep(edge_list$group.label.x, 2),
group.label.y = rep(edge_list$group.label.y, 2),
group = rep(edge_list$group, 2)
)
# Create a character vector containing every node name
all_nodes <- sort(node_list$name)
# Adjust the 'to' and 'from' factor levels so they are equal
# to this complete list of node names
plot_data <- edge_list %>% mutate(
to = factor(to, levels = all_nodes),
from = factor(from, levels = all_nodes))
name_order <- (node_list %>% arrange(group.label))$name
# Reorder edge_list "from" and "to" factor levels based on
# this new name_order
plot_data <- edge_list %>% mutate(
to = factor(to, levels = name_order),
from = factor(from, levels = name_order))
laliga.adjacency <- ggplot(plot_data, aes(x = from, y = to, fill = group)) +
geom_raster() +
# Because we need the x and y axis to display every node,
# not just the nodes that have connections to each other,
# make sure that ggplot does not drop unused factor levels
scale_x_discrete(drop = FALSE) +
scale_y_discrete(drop = FALSE) +
xlab(NULL) + ylab(NULL) +
scale_fill_manual(values = colors[c(-10, -12)],
labels = leagues[c(-10, -12)],
name = "Leagues") +
theme(
# Rotate the x-axis lables so they are legible
axis.text.x = element_blank(),
axis.text.y = element_blank(),
# Force the plot into a square aspect ratio
aspect.ratio = 1
# Hide the legend (optional)
)
laliga.adjacencybundes.links <- team_links %>%
filter(from %in% bundes.list | to %in% bundes.list)
bundes.nodes <- team_nodes %>%
filter(id %in% unique(c(as.character(bundes.links$from), as.character(bundes.links$to))))bundes.network <- graph_from_data_frame(d = bundes.links, vertices = bundes.nodes, directed = FALSE)V(bundes.network)$degree <- degree(bundes.network)
V(bundes.network)$closeness <- centralization.closeness(bundes.network)$res
V(bundes.network)$betweenness <- centralization.betweenness(bundes.network)$res
V(bundes.network)$eigen <- centralization.evcent(bundes.network)$vectorV(bundes.network)$size <- log(V(bundes.network)$value + 1) * 1.5
edge.color <- 1:length(E(bundes.network))
for(i in 1:nrow(bundes.nodes)){
index <- incident(bundes.network, V(bundes.network)[i], mode = 'out')
group_index <- bundes.nodes[i, "group.label"]
edge.color[index] <- colors[group_index]
}
vertex.color <- colors[V(bundes.network)$group.label]
plot(bundes.network, edge.arrow.size = .02,
vertex.frame.color = adjustcolor("#555555", alpha = .3),
edge.width = .5,
edge.color = adjustcolor(edge.color, alpha.f = .7),
vertex.color = adjustcolor(vertex.color, alpha = .6),
vertex.label = V(bundes.network)$label,
vertex.label.color = "black",
vertex.label.cex = .35,
vertex.label.family = "Helvetica",
layout=layout_nicely(bundes.network)
)
legend(x = -.9, y = -1, label, pch = 21, cex = 0.5,
text.width = 0.2, col= adjustcolor(vertex.color, alpha.f = .4),
pt.bg = adjustcolor(colors, alpha = .6), pt.cex = 1, bty = "n", ncol = 5)# Re-generate dataframes for both nodes and edges, now containing
# calculated network attributes
node_list <- get.data.frame(bundes.network, what = "vertices")
# Determine a community for each edge. If two nodes belong to the
# same community, label the edge with that community. If not,
# the edge community value is 'NA'
edge_list <- get.data.frame(bundes.network, what = "edges") %>%
inner_join(node_list %>% select(name, group.label), by = c("from" = "name")) %>%
inner_join(node_list %>% select(name, group.label), by = c("to" = "name")) %>%
mutate(group = as.factor(group.label.x))
edge_list <- data.frame(from = c(edge_list$from, edge_list$to),
to = c(edge_list$to, edge_list$from),
group.label.x = rep(edge_list$group.label.x, 2),
group.label.y = rep(edge_list$group.label.y, 2),
group = rep(edge_list$group, 2)
)
# Create a character vector containing every node name
all_nodes <- sort(node_list$name)
# Adjust the 'to' and 'from' factor levels so they are equal
# to this complete list of node names
plot_data <- edge_list %>% mutate(
to = factor(to, levels = all_nodes),
from = factor(from, levels = all_nodes))
name_order <- (node_list %>% arrange(group.label))$name
# Reorder edge_list "from" and "to" factor levels based on
# this new name_order
plot_data <- edge_list %>% mutate(
to = factor(to, levels = name_order),
from = factor(from, levels = name_order))
bundes.adjacency <- ggplot(plot_data, aes(x = from, y = to, fill = group)) +
geom_raster() +
# Because we need the x and y axis to display every node,
# not just the nodes that have connections to each other,
# make sure that ggplot does not drop unused factor levels
scale_x_discrete(drop = FALSE) +
scale_y_discrete(drop = FALSE) +
xlab(NULL) + ylab(NULL) +
scale_fill_manual(values = colors[c(-1, -8, -9, -10)],
labels = leagues[c(-1, -8, -9, -10)],
name = "Leagues") +
theme(
# Rotate the x-axis lables so they are legible
axis.text.x = element_blank(),
axis.text.y = element_blank(),
# Force the plot into a square aspect ratio
aspect.ratio = 1
# Hide the legend (optional)
)
bundes.adjacencyseriea.links <- team_links %>%
filter(from %in% seriea.list | to %in% seriea.list)
seriea.nodes <- team_nodes %>%
filter(id %in% unique(c(as.character(seriea.links$from), as.character(seriea.links$to))))seriea.network <- graph_from_data_frame(d = seriea.links, vertices = seriea.nodes, directed = FALSE)V(seriea.network)$degree <- degree(seriea.network)
V(seriea.network)$closeness <- centralization.closeness(seriea.network)$res
V(seriea.network)$betweenness <- centralization.betweenness(seriea.network)$res
V(seriea.network)$eigen <- centralization.evcent(seriea.network)$vectorV(seriea.network)$size <- log(V(seriea.network)$value + 1) * 1.5
edge.color <- 1:length(E(seriea.network))
for(i in 1:nrow(seriea.nodes)){
index <- incident(seriea.network, V(seriea.network)[i], mode = 'out')
group_index <- seriea.nodes[i, "group.label"]
edge.color[index] <- colors[group_index]
}
vertex.color <- colors[V(seriea.network)$group.label]
plot(seriea.network, edge.arrow.size = .02,
vertex.frame.color = adjustcolor("#555555", alpha = .3),
edge.width = .5,
edge.color = adjustcolor(edge.color, alpha.f = .7),
vertex.color = adjustcolor(vertex.color, alpha = .6),
vertex.label = V(seriea.network)$label,
vertex.label.color = "black",
vertex.label.cex = .35,
vertex.label.family = "Helvetica",
layout=layout_nicely(seriea.network)
)
legend(x = -.9, y = -1, label, pch = 21, cex = 0.5,
text.width = 0.2, col= adjustcolor(vertex.color, alpha.f = .4),
pt.bg = adjustcolor(colors, alpha = .6), pt.cex = 1, bty = "n", ncol = 5)# Re-generate dataframes for both nodes and edges, now containing
# calculated network attributes
node_list <- get.data.frame(seriea.network, what = "vertices")
# Determine a community for each edge. If two nodes belong to the
# same community, label the edge with that community. If not,
# the edge community value is 'NA'
edge_list <- get.data.frame(seriea.network, what = "edges") %>%
inner_join(node_list %>% select(name, group.label), by = c("from" = "name")) %>%
inner_join(node_list %>% select(name, group.label), by = c("to" = "name")) %>%
mutate(group = as.factor(group.label.x))
edge_list <- data.frame(from = c(edge_list$from, edge_list$to),
to = c(edge_list$to, edge_list$from),
group.label.x = rep(edge_list$group.label.x, 2),
group.label.y = rep(edge_list$group.label.y, 2),
group = rep(edge_list$group, 2)
)
# Create a character vector containing every node name
all_nodes <- sort(node_list$name)
# Adjust the 'to' and 'from' factor levels so they are equal
# to this complete list of node names
plot_data <- edge_list %>% mutate(
to = factor(to, levels = all_nodes),
from = factor(from, levels = all_nodes))
name_order <- (node_list %>% arrange(group.label))$name
# Reorder edge_list "from" and "to" factor levels based on
# this new name_order
plot_data <- edge_list %>% mutate(
to = factor(to, levels = name_order),
from = factor(from, levels = name_order))
seriea.adjacency <- ggplot(plot_data, aes(x = from, y = to, fill = group)) +
geom_raster() +
# Because we need the x and y axis to display every node,
# not just the nodes that have connections to each other,
# make sure that ggplot does not drop unused factor levels
scale_x_discrete(drop = FALSE) +
scale_y_discrete(drop = FALSE) +
xlab(NULL) + ylab(NULL) +
scale_fill_manual(values = colors[c(-5, -9, -10, -12)],
labels = leagues[c(-5, -9, -10, -12)],
name = "Leagues") +
theme(
# Rotate the x-axis lables so they are legible
axis.text.x = element_blank(),
axis.text.y = element_blank(),
# Force the plot into a square aspect ratio
aspect.ratio = 1
# Hide the legend (optional)
)
seriea.adjacency